home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / Development / PowerD / powerd / examples / Flare.d < prev    next >
Encoding:
Text File  |  2002-10-28  |  7.2 KB  |  321 lines
  1. // flare.d - simple lens flare renderer, it generates 24bit result in ram:flares.tga file
  2.  
  3. OPT    OPTIMIZE
  4.  
  5. MODULE    'intuition/intuition','intuition/screens','graphics/modeid','exec/memory',
  6.             'utility/tagitem'
  7.  
  8. CONST    W=320,H=240,MODEID=VGALORESDBL_KEY
  9. //CONST    W=640,H=480,MODEID=VGAPRODUCT_KEY
  10.  
  11. PROC main()
  12.     DEF    flist:PTR TO flare,r,x,y
  13.     //
  14.     // flare definition
  15.     //
  16.     flist:=[
  17.         FL_Linear    , 50.0, 0.00,1.00,1.00,1.00,
  18.         FL_Power        , 60.0, 0.00,0.00,0.30,1.00,
  19.         FL_FadeRing    , 30.0,-0.10,0.20,0.00,0.00,
  20.         FL_Circle    , 10.0, 0.20,0.10,0.15,0.10,
  21.         FL_Ring        , 34.0, 0.25,0.15,0.10,0.10,
  22.         FL_Circle    , 20.0, 0.30,0.10,0.10,0.20,
  23.         FL_Circle    , 14.0, 0.40,0.10,0.10,0.10,
  24.         FL_Power        ,  2.0, 0.47,0.10,0.70,1.00,
  25.         FL_Circle    ,  4.0, 0.55,0.10,0.10,0.10,
  26.         FL_Circle    , 26.0, 0.60,0.10,0.10,0.20,
  27.         FL_Circle    , 12.0, 0.70,0.10,0.20,0.10,
  28.         FL_Linear    , 16.0, 0.85,0.00,0.10,0.40,
  29.         FL_FadeRing    ,100.0, 1.00,0.30,0.05,0.00,
  30.         FL_FadeRing    ,200.0, 1.50,0.05,0.20,0.10,
  31.         FL_Last]:flare
  32. /*
  33.     DEFF    i
  34.     i:=Flare(flist,160,160,120,120)
  35.     PrintF('\d\n',i*1000)
  36. */
  37.     PrintF('Flare by MarK 23.2.2000\n')
  38.     PrintF('Press:\n\tLMB to change light position\n\tRMB to render flares\n\tany key for exit\n')
  39.     r,x,y:=Preview(flist)
  40.     IF r THEN Render(flist,x,y)
  41. ENDPROC
  42.  
  43. ENUM    FL_Last,
  44.         FL_Linear,
  45.         FL_Power,
  46.         FL_Circle,
  47.         FL_Ring,
  48.         FL_FadeRing
  49.  
  50. OBJECT flare
  51.     type:LONG,        // type of the flare (see FL... above)
  52.     size:FLOAT,        // size of the flare
  53.     pos:FLOAT,        // position on the flare line (0=light, 1.0=opposite the light)
  54.     r:FLOAT,            // colour of the flare
  55.     g:FLOAT,
  56.     b:FLOAT
  57.  
  58. //
  59. // preview and setup for rendering
  60. //
  61. PROC Preview(flist:PTR TO flare)(LONG,LONG,LONG)
  62.     DEF    s:PTR TO Screen,w:PTR TO Window,m:PTR TO IntuiMessage,end=FALSE,r=FALSE,mx,my
  63.     IF s:=OpenScreenTags(NIL,
  64.             SA_Width,W,
  65.             SA_Height,H,
  66.             SA_Depth,1,
  67.             SA_DisplayID,MODEID,
  68.             SA_Colors,[0,0,0,0,1,15,15,15,-1]:WORD,
  69.             TAG_END)
  70.         IF w:=OpenWindowTags(NIL,
  71.                 WA_Width,W,
  72.                 WA_Height,H,
  73.                 WA_CustomScreen,s,
  74.                 WA_IDCMP,IDCMP_MOUSEBUTTONS|IDCMP_VANILLAKEY,
  75.                 WA_Flags,WFLG_RMBTRAP|WFLG_ACTIVATE|WFLG_BORDERLESS,
  76.                 TAG_END)
  77.             SetAPen(w.RPort,1)
  78.             DrawFlare(w.RPort,flist,w.MouseX,w.MouseY)
  79.             mx:=w.MouseX
  80.             my:=w.MouseY
  81.             WHILE WaitPort(w.UserPort)
  82.                 IF m:=GetMsg(w.UserPort)
  83.                     IF m.Class=IDCMP_MOUSEBUTTONS
  84.                         IF m.Code=SELECTDOWN
  85.                             SetRast(w.RPort,0)
  86.                             DrawFlare(w.RPort,flist,mx:=w.MouseX,my:=w.MouseY)
  87.                         ELSEIF m.Code=MENUDOWN
  88.                             r:=TRUE
  89.                             end:=TRUE
  90.                         ENDIF
  91.                     ELSE
  92.                         end:=TRUE
  93.                     ENDIF
  94.                     ReplyMsg(m)
  95.                 ENDIF
  96.             EXITIF end=TRUE
  97.             ENDWHILE
  98.  
  99. //            WaitPort(w.UserPort)
  100.             CloseWindow(w)
  101.         ELSE PrintF('Unable to open window!\n')
  102.         CloseScreen(s)
  103.     ELSE PrintF('Unable to open screen!\n')
  104. ENDPROC r,mx,my
  105.  
  106. //
  107. // draw circles as flares
  108. //
  109. PROC DrawFlare(rp,flist:PTR TO flare,mx:FLOAT,my:FLOAT)
  110.     DEFF    cx,cy,dx,dy,x,y
  111.     cx:=W/2
  112.     cy:=H/2
  113.     dx:=cx-mx
  114.     dy:=cy-my
  115.     REPEAT
  116.         x:=dx*(flist.pos*2.0-1.0)
  117.         y:=dy*(flist.pos*2.0-1.0)
  118. //        PrintF('x=$\z\h[8]\ny=$\z\h[8]\n',x,y)
  119.         DrawEllipse(rp,x+cx,y+cy,flist.size/2,flist.size/2)
  120.         flist[]++
  121.     UNTIL flist.type=FL_Last
  122. ENDPROC
  123.  
  124. //
  125. // open output screen and window
  126. //
  127. PROC Render(flist:PTR TO flare,mx:FLOAT,my:FLOAT)
  128.     DEF    s:PTR TO Screen,w:PTR TO Window,vp,n,image:PTR TO RImage
  129.     IF s:=OpenScreenTags(NIL,
  130.             SA_Width,W,
  131.             SA_Height,H,
  132.             SA_Depth,8,
  133.             SA_DisplayID,MODEID,
  134.             TAG_END)
  135.         IF w:=OpenWindowTags(NIL,
  136.                 WA_Width,W,
  137.                 WA_Height,H,
  138.                 WA_CustomScreen,s,
  139.                 WA_IDCMP,IDCMP_MOUSEBUTTONS|IDCMP_VANILLAKEY,
  140.                 WA_Flags,WFLG_RMBTRAP|WFLG_ACTIVATE|WFLG_BORDERLESS,
  141.                 TAG_END)
  142.             vp:=ViewPortAddress(w)
  143.             FOR n:=0 TO 255 SetRGB32(vp,n,n<<24,n<<24,n<<24)
  144.             SetAPen(w.RPort,255)
  145.  
  146.             IF image:=NewImage(W,H)
  147. //                DrawFlare(w.RPort,flist,mx,my)
  148.                 RenderFlare(w.RPort,image,flist,mx,my)
  149.                 SaveTarga(image)
  150.                 DeleteImage(image)
  151.             ENDIF
  152.  
  153.             WaitPort(w.UserPort)
  154.             CloseWindow(w)
  155.         ELSE PrintF('Unable to open window!\n')
  156.         CloseScreen(s)
  157.     ELSE PrintF('Unable to open screen!\n')
  158. ENDPROC
  159.  
  160. //
  161. // render flare list
  162. //
  163. PROC RenderFlare(rp,im:PTR TO RImage,flist:PTR TO flare,mx:FLOAT,my:FLOAT)
  164.     DEFF    cx,cy,dx,dy,x,y,xx,yy,i,sx,sy,li:L
  165.     cx:=im.Width/2
  166.     cy:=im.Height/2
  167.     dx:=cx-mx
  168.     dy:=cy-my
  169.     REPEAT
  170.         x:=dx*(flist.pos*2.0-1.0)
  171.         y:=dy*(flist.pos*2.0-1.0)
  172.         sx:=x-flist.size/2
  173.         FOR xx:=sx TO x+flist.size/2
  174.         NEXTIF xx<=-cx
  175.         EXITIF xx>=cx
  176.             sy:=y-flist.size/2
  177.             FOR yy:=sy TO y+flist.size/2
  178.             NEXTIF yy<=-cy
  179.             EXITIF yy>=cy
  180.                 i:=Flare(flist,xx,yy,x,y)
  181.                 li:=RRePlot(im,xx+cx,yy+cy,i*flist.r,i*flist.g,i*flist.b)
  182.                 IF li
  183.                     SetAPen(rp,li)
  184.                     WritePixel(rp,xx+cx,yy+cy)
  185.                 ENDIF
  186.             ENDFOR
  187.             IF Mouse()=3 THEN RETURN
  188.         ENDFOR
  189.         flist[]++
  190.     UNTIL flist.type=FL_Last
  191. ENDPROC
  192.  
  193. //
  194. // get flare intensity
  195. //
  196. PROC Flare(flare:PTR TO flare,x:FLOAT,y:FLOAT,fx:FLOAT,fy:FLOAT)(FLOAT)
  197.     DEFF    i,l
  198. //    PrintF('\d,\d,\d,\d\n',fx*1000,fy*1000,x*1000,y*1000)
  199.     x-=fx
  200.     y-=fy
  201.     l:=Sqrt(x*x+y*y)                    // l = distance of rendering pixel and flare center
  202.     l/=flare.size/2.0                    // unify
  203.     IF l>1.0 THEN RETURN 0.0        // no intersection, end
  204.     SELECT flare.type
  205.     CASE FL_Linear
  206.         i:=1.0-l
  207.     CASE FL_Power
  208.         i:=(1.0-l)*(1.0-l)
  209.     CASE FL_Circle
  210.         IF l>0.95
  211. //            i:=20.0*(1.0-l)
  212.             i:=(1.0-l)*20.0
  213.         ELSE
  214.             i:=1.0
  215.         ENDIF
  216.     CASE FL_Ring
  217.         IF l>0.90
  218.             i:=(1.0-l)*10.0
  219.         ELSEIF l>0.80
  220.             i:=(l-0.80)*10.0
  221.         ELSE
  222.             i:=0.0
  223.         ENDIF
  224.     CASE FL_FadeRing
  225.         IF l>0.95
  226.             i:=(1.0-l)*20.0
  227.         ELSEIF l>0.50
  228.             i:=(l-0.50)*2.0
  229.         ELSE
  230.             i:=0.0
  231.         ENDIF
  232.     DEFAULT
  233.         i:=0.0
  234.     ENDSELECT
  235.     IF i>1.0 THEN i:=1.0
  236.     IF i<0.0 THEN i:=0.0
  237. ENDPROC i
  238.  
  239. //
  240. // image definition
  241. //
  242. OBJECT RGB
  243.     r:UBYTE,
  244.     g:UBYTE,
  245.     b:UBYTE
  246.  
  247. OBJECT BGR                    // for targa saving
  248.     b:UBYTE,
  249.     g:UBYTE,
  250.     r:UBYTE
  251.  
  252. OBJECT RImage
  253.     Width:LONG,
  254.     Height:LONG,
  255.     Pixel:PTR TO RGB
  256.  
  257. PROC NewImage(w,h)(PTR TO RImage)
  258.     DEF    image:PTR TO RImage
  259.     IFN image:=New(SIZEOF_RImage) THEN RETURN NIL
  260.     image.Width:=w
  261.     image.Height:=h
  262.     IFN image.Pixel:=New(SIZEOF_RGB*w*h)
  263.         Dispose(image)
  264.         RETURN NIL
  265.     ENDIF
  266. ENDPROC image
  267.  
  268. PROC RRePlot(image:PTR TO RImage,x,y,r:FLOAT,g:FLOAT,b:FLOAT)(LONG=0)
  269.     DEF    c,pixel:PTR TO RGB
  270.     IF x>=image.Width OR y>=image.Height OR x<0 OR y<0 THEN RETURN
  271.     r*=255
  272.     g*=255
  273.     b*=255
  274.     pixel:=image.Pixel[y*image.Width+x]
  275.  
  276.     r+=pixel.r
  277.     g+=pixel.g
  278.     b+=pixel.b
  279.  
  280.     IF r>255 THEN r:=255
  281.     IF g>255 THEN g:=255
  282.     IF b>255 THEN b:=255
  283.  
  284.     pixel.r:=r
  285.     pixel.g:=g
  286.     pixel.b:=b
  287.     c:=(pixel.r+pixel.g+pixel.b)/3
  288. ENDPROC c
  289.  
  290. PROC DeleteImage(image:PTR TO RImage)
  291.     IF image.Pixel THEN Dispose(image.Pixel)
  292.     Dispose(image)
  293. ENDPROC
  294.  
  295. //
  296. // save 24bit targa image
  297. //
  298. PROC SaveTarga(image:PTR TO RImage)
  299.     DEF    buff:PTR TO BGR,f,x,y,length,comment:PTR TO CHAR
  300.     PrintF('Saving...\b')
  301.     IF buff:=New(image.Width*image.Height*SIZEOF_BGR)
  302.         FOR y:=0 TO image.Height-1
  303.             FOR x:=0 TO image.Width-1
  304.                 buff[y*image.Width+x].r:=image.Pixel[y*image.Width+x].r
  305.                 buff[y*image.Width+x].g:=image.Pixel[y*image.Width+x].g
  306.                 buff[y*image.Width+x].b:=image.Pixel[y*image.Width+x].b
  307.             ENDFOR
  308.         ENDFOR
  309.         IF f:=Open('ram:flares.tga',NEWFILE)
  310.             comment:='$VER:This picture is generated by Martin Kuchinka''s simple Flare renderer.'
  311.             length:=StrLen(comment)
  312.             Write(f,[length,0,2,0,0,0,0,24,0,0,0,0,image.Width,image.Width>>8,image.Height,image.Height>>8,24,$20]:UBYTE,18)
  313.             Write(f,comment,length)
  314.             Write(f,buff,image.Width*image.Height*SIZEOF_BGR)
  315.             PrintF('Done.     \n')
  316.             Close(f)
  317.         ELSE PrintF('Unable to write image!\n')
  318.         Dispose(buff)
  319.     ELSE PrintF('Not enough memory!\n')
  320. ENDPROC
  321.